home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
program
/
tspa3540.zip
/
TSUNTE.TST
< prev
next >
Wrap
Text File
|
1993-01-23
|
5KB
|
204 lines
(* This is a test program for the TSUNTE.TPU unit 19-Aug-89,
Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89, 17-Jul-90,
26-Aug-92, 5-Oct-92, 23-Jan-93 *)
uses Dos, TSUNTE;
procedure LOGO;
begin
writeln;
writeln ('TSUNTE unit test by Prof. Timo Salmi');
writeln ('University of Vaasa, Finland, ts@uwasa.fi');
{$IFDEF VER40}
writeln ('TP version 4.0');
{$ENDIF}
{$IFDEF VER50}
writeln ('TP version 5.0');
{$ENDIF}
{$IFDEF VER55}
writeln ('TP version 5.5');
{$ENDIF}
{$IFDEF VER60}
writeln ('TP version 6.0');
{$ENDIF}
{$IFDEF VER70}
writeln ('TP version 7.0');
{$ENDIF}
writeln;
end; (* logo *)
(* Testing the cursor routines *)
procedure TEST1;
begin
CURSOFF;
writeln ('Cursor is off, press <═╝');
CLB;
readln;
CURSON;
writeln ('Cursor is on, press <═╝');
CLB;
readln;
CURSOR (0, 13);
writeln ('Cursor is big, press <═╝');
CLB;
readln;
CURSOR (6, 7);
writeln ('Cursor is normal, press <═╝');
CLB;
readln;
end; (* test1 *)
(* The most common system clock weekday *)
procedure TEST2;
const wkday : string[21] = 'SunMonTueWedThuFriSat';
begin
writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
writeln ('Week number ', WEEKNRFN (25,7,1980,false));
end; (* test2 *)
(* Special key status *)
procedure TEST5;
begin
if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
if SCRLONFN then writeln ('ScrollLock on') else writeln ('ScrollLock off');
end; (* test5 *)
(* Existence and size of a file
IMPORTANT: Never apply on an open file! *)
procedure TEST6;
var fname : string;
begin
fname := 'a:\command.com'; {Alter fname as appropriate}
if FEXISTFN (fname) then {**************************}
begin
writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
{$IFNDEF VER40}
writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
{$ENDIF}
end
else
writeln ('File ', fname, ' does not exist');
end; (* test6 *)
(* Get the entire command line, spaces and all *)
procedure TEST7;
begin
writeln;
writeln ('Command line = ', CMDLNFN);
writeln;
end; (* test7 *)
(* Demonstrate keyboard status, observe your keyboard status leds *)
procedure TEST8;
const loop = 100000; { adjust to your PC speed if necessary }
var i, j : longint;
begin
for j := 1 to 10 do
begin
CAPS (true);
NUMLOCK (false);
SCRLOCK (true);
if j = 1 then TEST5;
for i := 1 to loop do;
CAPS (false);
NUMLOCK (true);
SCRLOCK (false);
for i := 1 to loop do;
end;
TEST5;
end; (* test8 *)
(* The number of days in a given month and year *)
procedure TEST9;
var month, year : word;
begin
month := 7;
year := 1990;
writeln ('The last day of ', month, '-', year, ' is ',
LASTDMFN (month, year));
Flush (output);
month := 2;
year := 1988;
writeln ('The last day of ', month, '-', year, ' is ',
LASTDMFN (month, year));
Flush (output);
end; (* test9 *)
(* Test the validity of a date *)
procedure TEST10;
var day, month, year : word;
begin
day := 22;
month := 7;
year := 1990;
write ('Date ', day, '-', month, '-', year);
if DATEOKFN (day, month, year) then
writeln (' is valid')
else
writeln (' is NOT valid');
end; (* test10 *)
(* Test which date is earlier *)
procedure TEST11;
var day, month, year : word;
daynow, monthnow, yearnow, dummy : word;
z, znow : real;
begin
GetDate (yearnow, monthnow, daynow, dummy);
day := 22;
month := 7;
year := 1990;
write ('Date ', day, '-', month, '-', year);
z := ZELLERFN (day, month, year);
znow := ZELLERFN (daynow, monthnow, yearnow);
if z = znow then
writeln (' is today')
else if z < znow then
writeln (' is earlier than today')
else
writeln (' is later than today');
end; (* test11 *)
{$IFNDEF VER40} (* Not Turbo Pascal 4.0 *)
(* Get the default drive and its label *)
procedure TEST12;
var drive : char;
begin
drive := DEFDRVFN;
writeln ('Label on ', drive, ' is ', LABELFN (drive));
Flush (output);
end; (* test12 *)
{$ENDIF}
(* Attributes of files *)
procedure TEST13;
const FileName = 'c:\msdos.sys';
begin
writeln (FileName, ' is read-only = ', RDOFILFN (FileName));
Flush (output);
{}
writeln (FileName, ' is hidden = ', HIDFILFN (FileName));
Flush (output);
{}
writeln (FileName, ' is a system file = ', SYSFILFN (FileName));
Flush (output);
{}
writeln (FileName, ' arcvive bit on = ', ARCFILFN (FileName));
Flush (output);
end; (* test13 *)
(* Main program *)
begin
LOGO;
BORDER(5);
{$IFNDEF VER40} TEST7; {$ENDIF}
TEST1;
TEST2;
TEST5;
TEST6;
write ('Press <═╝'); readln;
BORDER(0);
{ If you want the rest of the test, insert the calls }
end. (* tsunte.tst *)